{-# LANGUAGE KindSignatures                #-}
{-# LANGUAGE MultiParamTypeClasses         #-}
{-# LANGUAGE FlexibleContexts              #-}
{-# LANGUAGE FlexibleInstances             #-}
{-# LANGUAGE ScopedTypeVariables               #-}
{-# LANGUAGE ExistentialQuantification     #-}
{-# LANGUAGE GADTs                         #-}
{-# LANGUAGE RankNTypes                    #-}


module Consistency
  ( check, languages ) where

import Language.Dependencies.References as R
import Language.Dependencies.Language

import Python
import Xml
import Json
import Html

-- system
import System.FilePath.Posix (takeExtension)
import Data.List as List
import Data.Map as Map
import Data.Set as Set

-- a list of supported languages
languages :: [Language]
languages =  [ Xml.languagexml
             , Json.languagejson
             , Html.languagehtml
             , Python.languagepython
             ]


-- Main interface

check :: Relation -> IO Bool
check r@(Relation (R.Elem (DPath pf1) fp1) (R.Elem (DPath pf2) fp2) cf) = do
    let ext1 = takeExtension fp1
    let ext2 = takeExtension fp2
    case (ext1,ext2) of
      (".py",".py")     -> plc (TheModuleSpan) (TheModuleSpan) parseP parseP (cPP cf) r
      (".json",".json") -> plc (TheJson)       (TheJson)       parseJ parseJ (cJJ cf) r
      (".py",".json")   -> plc (TheModuleSpan) (TheJson)       parseP parseJ (cPJ cf) r
      (".json",".py")   -> plc (TheModuleSpan) (TheJson)       parseP parseJ (cPJ cf) (flp r)
      (".py",".xhtml")  -> plc (TheModuleSpan) (TheDocument)   parseP parseX (cPX cf) r
      (".xhtml",".py")  -> plc (TheModuleSpan) (TheDocument)   parseP parseX (cPX cf) (flp r)
      (".json",".xhtml")-> plc (TheJson)       (TheDocument)   parseJ parseX (cJX cf) r
      (".xhtml",".json")-> plc (TheJson)       (TheDocument)   parseJ parseX (cJX cf) (flp r)
      (lext,rext) -> error $ "comparing filetypes "++lext++" and "++rext++" is currently not supported. exiting"

flp :: Relation -> Relation
flp (Relation e1 e2 cf) = Relation e2 e1 cf


-- ******************           CONSISTENCY           **************************

-- strip first and last character (occasionally used for "{var}" or "\"var\""
strip :: String -> String
strip [] = []
strip [x] = [x]
strip xs = tail . init $ xs

-- compare python files with each other
cPP :: CompareId -> Python.PYTHON ix1 -> Python.PYTHON ix2 -> ix1 -> ix2 -> Bool
cPP _ Python.TheExprSpan Python.TheExprSpan (Python.Strings ss1 _) (Python.Strings ss2 _) = ss1 == ss2
cPP _ _ _ _ _ = error "undefined"

cJJ :: CompareId -> Json.JSON ix1 -> Json.JSON ix2 -> ix1 -> ix2 -> Bool
cJJ (CompareId "samekeys") 
    Json.TheJson Json.TheJson 
    (Json.JObject _ dict1) (Json.JObject _ dict2) 
    = ( keysSet $ Map.fromList $ dict1) 
    == (keysSet $ Map.fromList $ dict2)
cJJ _ _ _ _ _ = error "undefined"


cPJ :: CompareId -> Python.PYTHON ix1 -> Json.JSON ix2 -> ix1 -> ix2 -> Bool
cPJ _ Python.TheExprSpan Json.TheKey (Python.Strings [ss1] _) (Json.JKey _ ss2) = strip ss1 == ss2
cPJ _ Python.TheExprSpan Json.TheJson (Python.Strings [ss1] _) (Json.JString _ ss2) = strip ss1 == ss2
cPJ _ _ _ _ _ = error "undefined"

cPX :: CompareId -> Python.PYTHON ix1 -> Xml.XML ix2 -> ix1 -> ix2 -> Bool
cPX (CompareId "dynvar") Python.TheExprSpan Xml.TheContent (Python.Strings [ss1] _) (Xml.CString _ ss2 _) = strip ss1 == strip ss2
cPX (CompareId "httpvar") Python.TheExprSpan Xml.TheContent (Python.Strings [ss1] _) (Xml.CElem (Xml.Elem _ as _) _) = isInfixOf (strip ss1) (fetchHref as) where

  fetchHref :: [Attribute] -> String
  fetchHref as = decode $ snd $ head $ List.filter (\(name,attv) -> name =="href") as

  decode :: AttValue -> String
  decode (AttValue ((Left s):rest)) = s++(decode (AttValue rest))
  decode (AttValue ((Right (RefEntity s)):rest)) = "&"++s++";"++(decode $ AttValue rest)
  decode (AttValue []) = ""

cPX _ _ _ _ _ = error "undefined"

cJX :: CompareId -> Json.JSON ix1 -> Xml.XML ix2 -> ix1 -> ix2 -> Bool
cJX _ Json.TheKey  Xml.TheContent (Json.JKey _ ss1) (Xml.CString _ ss2 _) = ss1 == strip ss2
cJX _ Json.TheJson Xml.TheContent (Json.JString _ ss1) (Xml.CString _ ss2 _) = ss1 == strip ss2
cJX _ _ _ _ _ = error "undefined"

-- ******************           unsafe PARSING           **************************

parseP :: String -> Python.ModuleSpan
parseP x = let Right a = Python.parPython x in a

parseX :: String -> (Xml.Document Xml.Posn)
parseX x = let Right a = Xml.parseXML x in a

parseJ :: String -> (Json.Json)
parseJ x = let Right a = Json.parseJson x in a

parseH :: String -> (Html.Html)
parseH x = let Right a = Html.parseHtml x in a


